home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / wildproc.arc / WILDPROC.PRG < prev   
Encoding:
Text File  |  1986-11-19  |  3.9 KB  |  100 lines
  1. *****************************************************************************  
  2. *  WILDPROC.PRG                                                             *  
  3. *****************************************************************************
  4. *                                                                           *
  5. * W I L D                                                                   *
  6. *                                                                           *
  7. * This procedure is used to generate a macro to be used with a filter       *
  8. * or copy command to select records based on a wild card.                   * 
  9. *                                                                           *
  10. * AUTHOR:    Laurens Meyer, Remarkable Enterprises, Dunedin New Zealand     *
  11. *                                                                           *
  12. * SOURCE ID: AAJ865                                                         *
  13. *                                                                           *
  14. * INPUTS:    codematch   This has the wildcard ie '???A0??'                 *
  15. *            field       Name of the database field to match                *
  16. *                                                                           *
  17. * OUTPUTS:   matchmac    Macro used in SET FILTER etc ie                    *
  18. *                           COPY TO temp FOR &matchmac                      *
  19. *                           SET FILTER TO &matchmac                         *
  20. *                                                                           *
  21. *****************************************************************************
  22. PROCEDURE wild
  23.     PARAMETERS codematch, matchmac, field
  24.     PRIVATE cnt1, cnt2, work1, work2, work3, sstr, scnt, len
  25.  
  26.     len = LEN(codematch)
  27.     matchmac = ''
  28.  
  29. * First look for total match
  30.  
  31.     IF AT('?', codematch)=0
  32.         matchmac = field+"='"+codematch+"'"
  33.     ELSE
  34.  
  35. * Next for no match
  36.  
  37.         cnt1 = 1
  38.         DO WHILE cnt1 <= len .AND. SUBSTR(codematch, cnt1, 1)='?'
  39.             cnt1 = cnt1 + 1
  40.         ENDDO
  41.         IF cnt1 <= len
  42.  
  43. * Now build matchmac for part match
  44.  
  45.             cnt1 = 1
  46.             cnt2 = 1
  47.             DO WHILE cnt1 <= len
  48.  
  49. * Look for first non '?'
  50.  
  51.                 IF SUBSTR(codematch, cnt1, 1)='?'
  52.                     cnt1 = cnt1 + 1
  53.                 ELSE
  54.                     scnt = cnt1
  55.                     sstr = ''
  56.                     DO WHILE cnt1 <= len .AND. SUBSTR(codematch, cnt1, 1)<>'?'
  57.                         sstr = sstr + SUBSTR(codematch, cnt1, 1)
  58.                         cnt1 = cnt1 + 1
  59.                     ENDDO
  60.                     IF cnt2 > 9
  61.                         ext = STR(cnt2, 2, 0)
  62.                     ELSE
  63.                         ext = STR(cnt2, 1, 0)
  64.                     ENDIF
  65.                     work1 = 'SCNT'+ext
  66.                     work2 = 'SLEN'+ext
  67.                     work3 = 'SSTR'+ext
  68.                     cnt2 = cnt2 + 1
  69.                     &work1 = STR(scnt, 2, 0)
  70.                     &work2 = STR(cnt1-scnt, 2, 0)
  71.                     &work3 = sstr
  72.                 ENDIF
  73.             ENDDO
  74.  
  75. * Now construct matchmac
  76.  
  77.             cnt1 = 1
  78.             DO WHILE cnt1 < cnt2
  79.                 IF LEN(matchmac) > 1
  80.                     matchmac = matchmac + ' .AND. '
  81.                 ENDIF
  82.                 IF cnt1 > 9
  83.                     ext = STR(cnt1, 2, 0)
  84.                 ELSE
  85.                     ext = STR(cnt1, 1, 0)
  86.                 ENDIF
  87.                 work1 = 'SCNT'+ext
  88.                 work2 = 'SLEN'+ext
  89.                 work3 = 'SSTR'+ext
  90.                 matchmac = matchmac + 'SUBSTR('+field+','+&work1+','+;
  91.                                       &work2+')'+'='+"'"+&work3+"'"
  92.                 cnt1 = cnt1 + 1
  93.             ENDDO
  94.         ENDIF
  95.     ENDIF
  96.     RELEASE cnt1, cnt2, work1, work2, work3, sstr, scnt, len
  97. RETURN
  98.  
  99. * EOP
  100.